home *** CD-ROM | disk | FTP | other *** search
/ Aminet 33 / Aminet 33 - October 1999.iso / Aminet / dev / basic / hsb_iconfuncs.lha / hsb_iconfuncs / BLib / IconFuncs.bas
Encoding:
BASIC Source File  |  1999-08-22  |  4.2 KB  |  159 lines
  1. '' $Id: IconFunc.bas, V1.4 1998-01-03 $
  2. '' $VER: IconFunc.bas V1.4
  3. '' 
  4. '' Compiler: HBC 2.0
  5. '' Includes: 3.1
  6. ''
  7. '' Author: steffen.leistner@styx.in-chemnitz.de
  8. '' Copyright: © Steffen Leistner 1996-98
  9. '' Status: FreeWare, use on your own Risk
  10. '' 
  11. ''
  12. '' include this: exec.bh, intuition.bh, dos.bh, workbench.bh, icon.bh, utility.bh
  13. '' open libs:    exec.library, intuition.library, dos.library, workbench.library
  14. ''               icon.library
  15.  
  16. '******************************************************************************
  17.  
  18. 'returns the full path and name of the current program
  19.  
  20. FUNCTION FullProgramName$
  21.     LOCAL workbuf&, thistask&, programname$
  22.     FullProgramName$ = ""
  23.     
  24.     workbuf& = AllocVec&(512&, MEMF_PUBLIC& OR MEMF_CLEAR&)
  25.     IF workbuf& = NULL&
  26.         EXIT FUNCTION
  27.     END IF
  28.  
  29.     IF GetProgramName&(workbuf&, 512&)            'Start from CLI
  30.         programname$ = PEEK$(workbuf&)
  31.     ELSE                                        'Start from Workbench
  32.         Forbid
  33.         thistask& = FindTask&(NULL&)
  34.         Permit
  35.         programname$ = PEEK$(PEEKL(thistask& + tc_Node% + ln_Name%))
  36.     END IF
  37.  
  38.     IF GetCurrentDirName& (workbuf&, 512&)
  39.         IF AddPart&(workbuf&, SADD(programname$ + CHR$(0)), 512&)
  40.             FullProgramName$ = PEEK$(workbuf&)
  41.         END IF
  42.     END IF
  43.     FreeVec workbuf&
  44.  
  45. END FUNCTION
  46.  
  47. '******************************************************************************
  48.  
  49. 'reads the Tooltype-Entries from a given Icon
  50.  
  51. '    wbobject$ = full path and name of the wbobject (without ".info")
  52. '    tooltypes$() = array of tooltypes, see example
  53. '    results$() = array of string results, should by empty before call the function
  54.  
  55. FUNCTION ReadToolTypes&(wbobject$, tooltypes$(), results$())
  56.     LOCAL diskobj&, z%
  57.     ReadToolTypes& = NULL&
  58.     
  59.     diskobj& = GetDiskObject&(SADD(wbobject$ + CHR$(0%)))
  60.     IF diskobj&
  61.         FOR z% = 0% TO UBOUND(tooltypes$)
  62.             results$(z%) = PEEK$(FindToolType&(PEEKL(diskobj& + do_ToolTypes%), _
  63.                             SADD(tooltypes$(z%) + CHR$(0%))))
  64.         NEXT z%
  65.         ReadToolTypes& = TRUE&
  66.         FreeDiskObject diskobj&
  67.     END IF
  68.     
  69. END FUNCTION
  70.  
  71. '******************************************************************************
  72.  
  73. 'save tooltypes to a given wbobject
  74.  
  75. '    wbobject$ = full path and name of the wbobject (without ".info")
  76. '    deftool$ = name of the default tool (only project/disk icons)
  77. '    ttype$() = array of complete tooltypes (eg. "FOOBAR=987654321")
  78.  
  79. SUB SaveToolTypes (wbobject$, deftool$, ttype$())
  80.     LOCAL diskobj&, z%
  81.     
  82.     diskobj& = GetDiskObjectNew&(SADD(wbobject$ + CHR$(0%)))
  83.     IF diskobj&
  84.         junk& = FRE(" ")
  85.         DIM args&(UBOUND(ttype$) + 1%)
  86.         FOR z% = 0% TO UBOUND(ttype$)
  87.             args&(z%) = SADD(ttype$(z%) + CHR$(0%))
  88.         NEXT z%
  89.         POKEL diskobj& + do_ToolTypes%, VARPTR(args&(0%))
  90.         IF PEEKW(diskobj& + do_Type%) = WBPROJECT&
  91.             POKEL dobj& + do_DefaultTool%, SADD(deftool$ + CHR$(0%))
  92.         END IF
  93.         junk& = PutDiskObject& (SADD(wbobject$ + CHR$(0%)), diskobj&)
  94.         FreeDiskObject diskobj&
  95.         ERASE args&
  96.     END IF
  97.  
  98. END SUB
  99.  
  100. '******************************************************************************
  101.  
  102. 'edit a Icon via workbench or dopus - functions
  103.  
  104. '    win& = address of parent window (NULL& is valid)
  105. '    icon$ = full path and name to the icon
  106.  
  107. SUB EditIcon (win&, icon$)
  108.     IF (icon$ <> "")
  109.         IF FEXISTS(icon$)
  110.             pname$ = icon$ + CHR$(0%)
  111.             POKEB PathPart&(SADD(pname$)), 0%
  112.         
  113.             Forbid
  114.             IF FindPort&(SADD("DOPUS.1" + CHR$(0%)))
  115.                 Permit
  116.                 
  117.                 cic% = PEEKB(SYSTAB + 33%)
  118.                 POKEB SYSTAB + 33%, 0%
  119.                 
  120.                 tempscript$ = "T:DOIconInfo.rx"
  121.                 ffile% = FREEFILE
  122.                 OPEN tempscript$ FOR OUTPUT AS #ffile%
  123.                     PRINT #ffile%, "/* Show Icon via DOpus */"
  124.                     PRINT #ffile%, "ADDRESS 'DOPUS.1'"
  125.                     PRINT #ffile%, "DOPUS FRONT"
  126.                     PRINT #ffile%, "COMMAND wait IconInfo "; CHR$(34%); icon$; CHR$(34%)
  127.                     PRINT #ffile%, "EXIT"
  128.                 CLOSE #ffile%    
  129.                 
  130.                 junk& = SystemTagList&(SADD("SYS:Rexxc/RX " + tempscript$ + CHR$(0%)), NULL&)
  131.                 KILL tempscript$
  132.                 POKEB SYSTAB + 33%, cic%
  133.             
  134.             ELSE
  135.                 Permit
  136.                 
  137.                 IF win& <> NULL&
  138.                     scr& = PEEKL(win& + WScreen%)
  139.                 ELSE
  140.                     scr& = LockPubScreen&(NULL&)
  141.                 END IF
  142.             
  143.                 lck& = Lock&(SADD(pname$), ACCESS_READ&)
  144.                 IF lck&
  145.                     old& = CurrentDir&(lck&)
  146.                     fls$ = PEEK$(FilePart&(SADD(icon$ + CHR$(0%))))
  147.                     fln$ = LEFT$(fls$, LEN(fls$) - 5%) + CHR$(0%)
  148.                     WBInfo lck&, SADD(fln$), scr&
  149.                     junk& = CurrentDir&(old&)
  150.                     UnLock lck&
  151.                 END IF
  152.             
  153.                 IF win& = NULL&
  154.                     UnLockPubScreen NULL&, scr&
  155.                 END IF
  156.             END IF
  157.         END IF
  158.     END IF
  159. END SUB